home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CICA 1993 April
/
CICA MS Windows - April 1993.iso
/
unzipped
/
programr
/
vbasic
/
sndex
/
vbsndex.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-10-15
|
2KB
|
63 lines
library VBSNDEX;
uses Strings;
{This is how to declare the LP2STR function in TPW}
function LP2STR (pb:PChar;cbLen:Integer):Pointer;Far;
External 'VBPOINT' index 2;
function Soundex (Source:Pchar): Pointer;export;
const
Work: array [0..4] of char = '0000';
SS: array [0..17] of char = 'BFPVCGJKQSXZDTLMNR';
RS: array [0..17] of char = '111122222222334556';
var
Result: pchar;
SPos, DPos, RPos: integer;
PCode: Char;
begin
Result := StrNew (Work);
Result[0] := UpCase (Source[0]);
DPos := 1;
SPos := 1;
PCode := #0;
while (DPos < 4) AND (Source [SPos] <> #0) do
begin
RPos := StrScan (SS, UpCase (Source[SPos])) - SS;
if RPos > 0 then
begin
if RS [RPos] <> PCode then
begin
Result[DPos] := RS [RPos];
PCode := RS [RPos];
Inc (DPos);
end;
end
else
PCode := #0;
Inc (SPos);
end;
{This is the operative bit. Result now contains a
long pointer to a string (LPSTR). We pass this
address and a byte count to LP2STR which creates a
Visual Basic language string (HLSTR) and returns the
handle to use here. We assign that handle as our
function result and then destroy our copy of the
string. Easy, right?}
Soundex := LP2STR (Result, 4);
StrDispose (Result);
end;
exports
SOUNDEX resident;
begin
end.